Очень крутое описание проекта

IMDb - крупнейшая в мире база данных и веб-сайт о кинематографе. IMDb предоставляет пользователям возможность не только узнать о новинках кинематографа, найти информацию об интересующих фильмах, сериалах, личностях, связанных с кино, но найти чарты, рейтинги, отзывы для более чем 4,7 млн кинофильмов и телесериалов. Последнее и является предметом этого проекта. Особенностью отзывов на IMDb является пометка “Warning: Spoilers”, которая предупреждает читателя, о наличии в тексте раскрытия сюжета.

Спойлерские отзывы
Текст отзывов, который содержат в себе спойлеры, сначала скрыт, для того, чтобы прочитать его, необходимо его дополнительно раскрыть. При желании можно скрыть все подобные отзывы нажатием кнопки “Hide Spoilers”. Пометку о наличии спойлера пользователь устанавливает сам. Если он этого не сделал, то по правилам imdb, отзыв удаляется.

Несмотря на то, что спойлеры, особенно в сети, считаются нежелательными, люди все равно оставляют такие отзывы. Интересно исследовать на “причины” их написания.

Будем проверять следующие гипотезы:

Также посмотрим на слова, характерные для спойлерских отзывов и для отзывов с разными оценками.

Данные

Сначала был сформирован список фильмов и сериалов, у которых в дальнейшем были собраны ревью.

Основой послужили следующие чарты:

Для того, чтобы проверить теорию о том, что спойлеры скорее будут писаться к фильмам с низким рейтингом, были взяты два типа данных Top Rated и Lowest Rated, а для того, чтобы проверить связь с типом картины (фильм/сериал), были взяты списки и фильмов и сериалов.

Из каждого списка были выбраны случайным образом 100 названий (чтобы кол-во объектов в каждой категории было одинаковым). Далее были собраны отзывы и метаданные. Максимальное кол-во отзывов для каждого фильма и сериала - 25. Это связано с тем, что IMDb позволяет достатать только такое кол-во.

В итоге получилось 8382 отзыва.

В ходе проекта были созданы следующие датасеты:

Пакеты

suppressMessages(library(tidyverse))
library(ggplot2)
library(wesanderson)
suppressMessages(library(gridExtra))
library(packcircles)
library(tidytext)
library(stopwords)
library(dplyr)
suppressMessages(library(textstem))
suppressMessages(library(reshape))
library(ggpubr)
## Loading required package: magrittr
## 
## Attaching package: 'magrittr'
## The following object is masked from 'package:purrr':
## 
##     set_names
## The following object is masked from 'package:tidyr':
## 
##     extract
options(warn=-1)
set.seed(42)

Загрузка данных

filename <- "data/all_review_data100_3.csv"
df <- read.delim(filename, sep='\t', header = TRUE)

nr <- nrow(df)

Добавим в датесет информацию о рейтингах и типах произведения. Для этого сначала откроем датасет с рейтингами, из которых были взяты фильмы и сериалы, и достанем нужную информацию.

filename2 <- "data/id_list6.csv"
df_tops <- read.delim(filename2, sep=',', header = TRUE)

df_tops["movieid"] <- as.character(df_tops$movieid) 
df["movie_id"] <- as.character(df$movie_id)

#row.names(df_tops) <- df_tops$movieid
#tops <- df_tops[df$movie_id,]$top_name
#df['type'] <- str_match(tops, "(movies|tv)_")[,2]
#df['top'] <- str_match(tops, "(low|top)_")[,2]


# Обнаружила несоответвия в данных, поэтому пришлось переделать с циклом

df['top'] <- rep(NA, nr)
df['type'] <- rep(NA, nr)

a <- unique(df$movie_id)

for (id in a){
  
  l <- df_tops$top_name[df_tops$movieid == id]
  
  df$top[df$movie_id == id] <- str_match(l, "(low|top)_")[,2]
  df$type[df$movie_id == id] <- str_match(l, "(movies|tv)_")[,2]
}

# df %>% filter(movie_id == 'tt0808240') %>% select(top)

Еще добавим год выхода фильма

data_path <- "data/tops2"
filenames <- list.files(data_path, pattern="*.csv", full.names=TRUE)

movie_data <- list(id=c(), date=c())

for (i in 1:4){
  data <- read.delim(filenames[[i]], sep='\t', header = TRUE)
  movie_data$id <- c(movie_data$id, as.character(data$ids))
  movie_data$date <- c(movie_data$date, data$years)
  movie_data$mov_rate <- c(movie_data$mov_rate, data$rates)
}

movie_data <- data.frame(movie_data)

#df['year'] <- movie_data[df$movie_id,]$date
#df['mov_rate'] <- movie_data[df$movie_id,]$mov_rate

#write_delim(df, "data/full_review_dataset.csv", delim="\t")



df['year'] <- rep(NA, nr)
df['mov_rate'] <- rep(NA, nr)

for (id in a){
  
  l <- movie_data[movie_data$id == id,]
  
  df$year[df$movie_id == id] <- l$date
  df$mov_rate[df$movie_id == id] <- l$mov_rate
}

Посмотрим на данные

head(df %>% select("movie_id", "rate", "spoiler", "date", "user", "help_plus", "help_all"), 5)
##    movie_id rate spoiler              date      user help_plus help_all
## 1 tt0120179    3       0      7 April 2003 ur1980092       134      160
## 2 tt0120179    2       0      2 March 2007 ur1293485        52       62
## 3 tt0120179   NA       0 14 September 2003 ur1219578        79      102
## 4 tt0120179    1       0       6 June 2004 ur3515639        82      108
## 5 tt0120179   NA       0   11 January 2004 ur1002035        53       68

Вообще отзыв пользователя о фильме на imdb содержит:

Что такое “Оценка читателя”?
Каждый зарегистрированный пользователь может оценить отзыв с точки зрения его полезности. Например, “37 out of 43 found this helpful”. Это означает, что 43 человека оценили отзыв на фильм, и 37 из них сочли его полезным. В дальнейшем кол-во оценивших отзыв людей для удобства будем называть просмотрами.

Датасет содержит следующие данные:

Для удобства сгруппируем данные по наличию или отсутсвию спойлера в отзыве

spoil <- df %>% filter(spoiler == 1)
no_spoil <- df %>% filter(spoiler == 0)

Доля спойлеров

Посмотрим на кол-во спойлеров в данных.

df %>% select(spoiler)  %>% 
       group_by(spoiler) %>% 
       summarise(prop = scales::percent(n() / nr))
## # A tibble: 2 x 2
##   spoiler prop 
##     <int> <chr>
## 1       0 80%  
## 2       1 20%

Так как для каждого фильма IMDb позволяет скачать только первые 25 комментариев (отсортированные, видимо, по helpfulness), мы не можем с точностью утвержать, является ли справедливым подобное соотношение для генеральной совокупности.

Оценки пользователей

df %>% 
      select(rate, spoiler) %>%
      group_by(spoiler) %>%
      count(rate) %>% drop_na() %>% 
    
      ggplot(aes(x=factor(rate), y=n, fill=as.character(spoiler))) + 
      geom_bar(position="stack", stat="identity") + 
      scale_fill_manual("Отзыв", values=c("gray83", "skyblue2"),
                        labels = c("Без спойлеров", "Со спойлерами")) +
      geom_text(aes(label=n), vjust=0, color="black", size=2, position=position_stack(0.5)) + 
      theme_minimal() + 
      ggtitle("Кол-во оценкок пользователей, написавших отзыв, по группам ") +
      xlab("Оценка из 10 баллов") + 
      ylab("Кол-во")

Далее для подсчетов мы будем часто прибегать к двоичному представлению шкалы оценок. Будем считать, что 1-6 - негативная оценка фильма, а 7-10 - позитивная. Это разделение сделано на основе распределения итоговых рейтингов фильмов и чартов, из котрых были взяты данные. Как видно из графика ниже, оценки, которые характерны для top rated фильмов варьируются между 8-10, так как в данных нет ни одного фильма о рейтингом 7, будет считать, что подобная оценка попабает в раздел top rated.

df['mov_rate'] <- round(df$mov_rate)

df %>% 
      select(top, mov_rate) %>%
      group_by(top) %>%
      count(mov_rate) %>% drop_na() %>% 
    
      ggplot(aes(x=factor(mov_rate), y=n, fill=top)) + 
      geom_bar(position="stack", stat="identity") +
      scale_fill_manual("Чарт", values=c("gray83", "skyblue2")) +
      theme_minimal() + 
      ggtitle("Оценки фильмов в зависимости от типа чарта") +
      xlab("Оценка из 10 баллов") + 
      ylab("Кол-во")

Процент спойлерских отзывов в рамках каждой оценки

rate_count <- df %>% group_by(rate) %>% drop_na() %>% count()

spoil %>% 
      select(rate) %>% 
      drop_na() %>% 
      count(rate) %>%
      mutate(per = n / rate_count$n * 100)
## # A tibble: 10 x 3
##     rate     n   per
##    <int> <int> <dbl>
##  1     1   375  23.2
##  2     2    70  24.2
##  3     3    62  29.0
##  4     4    45  28.1
##  5     5    47  26.7
##  6     6    56  24.8
##  7     7    67  23.8
##  8     8    79  17.9
##  9     9   150  18.3
## 10    10   522  17.3

Анализ

Зависимость кол-ва просмотров комментария от оценки фильма рецензентом

Кажется, что люди чаще читают негативные отзывы, чтобы понять будет ли им это интересно или нет.

H0 - Зависимость нет
H1 - Зависимость есть

# Функция, которая превращает вектор в бинарный

bin_vals <- function(data, vec, val, res1=0, res2=1){
  data['bin'] <- vec
  data$bin[data$bin <= val] <- res1
  data$bin[data$bin > val] <- res2
  return(data)
  }


help_rates <- df %>% select(help_all, rate) %>% drop_na() 
help_rates <- bin_vals(help_rates, help_rates$rate, 6)

Проверим данные на нормальность.

ggqqplot(help_rates$help_all)

Данные не распределены нормально. Данные количественные. В качестве теста будем использовать Критерий Манна-Уитни.

# Функция рисует график плотности

dens_plot <- function(data1, data2, name1, name2, alpha){
  p <- ggplot() + 
    geom_density(aes(x = data1, fill = name1), alpha = alpha) +
    geom_density(aes(x = data2, fill = name2), alpha = alpha) +
    theme_minimal()
  return(p)
}


# Функция рисует гистограмму

hist_plot <- function(data1, data2, name1, name2, alpha, bin){
  p <- ggplot() + 
    geom_histogram(aes(x = data1, fill = name1), bins = bin, alpha = alpha) +
    geom_histogram(aes(x = data2, fill = name2), bins = bin, alpha = alpha) +
    theme_minimal()+
    scale_y_log10()
  return(p)
}


# Функция рисует столбчатый график 

bar_plot <- function(data1, data2, name1, name2, alpha){
  p <- ggplot() + 
    geom_bar(aes(x = data1, fill = name1), alpha = alpha) +
    geom_bar(aes(x = data2 , fill = name2), alpha = alpha) +
    theme_minimal()
  return(p)
}


# Функция считает  Критерий Манна-Уитни и рисует график

testing <- function(data1, data2, name1, name2, alpha, equal=F, plt='dens', bin=30){
  
  if (equal == T){
    len <- length(data2)
    data1 <- sample(data1, len)}
  
  test <- wilcox.test(data1, data2)
  
  if (plt == 'hist'){
    p <- hist_plot(data1, data2, name1, name2, alpha, bin)}
  
  else if (plt == 'bar'){
    p <- bar_plot(data1, data2, name1, name2, alpha)}
 
  else if (plt == 'dens'){
    p <- dens_plot(data1, data2, name1, name2, alpha)}
  
  return(list(test=test$p.value, plot=p))
}

Проведем тесты

p_help_rates <- help_rates %>% filter(bin == 1) %>% drop_na()
n_help_rates <- help_rates %>% filter(bin == 0) %>% drop_na()

res <- testing(p_help_rates$help_all, n_help_rates$help_all,
               'положительная', 'отрицательная', 
               0.3, plt='dens') 

res$test
## [1] 0.8932284

p-value = 0.8932284
p-value > 0.05
Следовательно мы не можем отвергануть H0. Зависимости между кол-вом просмотров комментария и оценки фильма рецензентом нет.

res$plot +
      ggtitle("График плотности кол-ва просмотров отзыва") +
      xlab("Кол-во просмотров") + 
      ylab("Плотность") +
      scale_fill_discrete(name = "Оценка фильма")

Зависимость кол-ва просмотров комментария от наличия спойлеров

Кажется, что люди будут меньше смотреть комментарии со спойлерами, потому что никто не хочет себе испортить впечатление.

H0 - Зависимость нет
H1 - Зависимость есть

Данные остаются из предыдущего пункта, поэтому просто считаем результат

s_help <- spoil %>% select(help_all) %>% drop_na()  
n_help <- no_spoil %>% select(help_all) %>% drop_na() 

res <- testing(n_help$help_all, s_help$help_all,
               'без спойлеров', 'со спойлерами', 
               0.3, plt='dens', ) 

res$test
## [1] 2.48729e-07

p-value = 2.48729e-07
p-value < 0.05
Следовательно мы отвергаем H0. Зависимость между кол-вом просмотров комментария и наличием спойлеров есть. Но какая?

res$plot +
      ggtitle("График плотности кол-ва просмотров отзыва от наличия спойлера") +
      xlab("Кол-во просмотров") + 
      ylab("Плотность") +
      scale_fill_discrete(name = "Наличие спойлера")

Видно, что отзывы со спойлерами просматриваются реже, чем отзывы без спойлеров. Посмотрим на медианы и средние.

# Функция красиво рисует значения медиан и средних 

mean_median <- function(data1, data2, name1, name2, title){
  
  a <- lapply(list(data1, data2), mean)
  b <- lapply(list(data1, data2), median)
  labls <- round(c(unlist(b), unlist(a)))
  
  c <- as_tibble(list(labls=labls,
                      x=rep(c(name1, name2), 2), 
                      y=rep(c("mean", "median"), each=2)))
  
  p <- ggplot(data=c, aes(x=x, y=y)) +
    geom_point(aes(color=factor(x)), size = labls/2) +
    geom_text(label=labls, size=log(labls)*2, color="black")+
    theme_minimal() +
    theme(legend.position="none",
          axis.title.x = element_blank(),
          axis.title.y = element_blank()) +
    labs(title=title)
  print(p)
}


mean_median(n_help$help_all, s_help$help_all,
            "без спойлеров", "со спойлерами",
            "График средних значений и медиан просмотров отзывов \n в зависимости от наличия спойлера")

Действительно, отзывы со спойлерами просматриваются в среднем реже.

Зависимость наличия спойлеров с оценкой фильма пользователем

Кажется, что, если фильм человеку не понравился, он больше захочет наспойлерить его сюжет.

H0 - Зависимость нет H1 - Зависимость есть

Проверим данные на нормальность

ggqqplot(df$rate)

Данные не распределены нормально. Данные порядковые качественные. В качестве теста будем использовать Критерий Манна-Уитни. Так как границы оценки определены заранее, выбросов тут быть не может.

n_rate <- no_spoil %>% select(rate) %>% drop_na()
s_rate <- spoil %>% select(rate) %>% drop_na()

res <- testing(n_rate$rate, s_rate$rate,
               'без спойлеров', 'со спойлерами', 
               0.3, plt='dens')

res$test
## [1] 7.515512e-10

p-value = 7.515512e-10
p-value < 0.05
Следовательно мы отвергаем H0. Зависимость между наличием спойлеров с оценкой фильма пользователем есть.

res$plot +
      ggtitle("График плотности просмотров отзыва в зависимости от оценки фильма") +
      xlab("Оценка фильма") + 
      ylab("Плотность") +
      scale_fill_discrete(name = "Наличие спойлера") + 
      scale_x_discrete(limits=1:10)

Вероятность высокой оценки фильма у отзыва без спойлеров больше, чем вероятность высокой оценки фильма у отзыва со спойлерами. Но пока непонятно, значимо ли это различие для совсем низких оценок. Возьмем только негативные отзывы и проверим влияние спойлеров там.

b_rate <- bin_vals(df, df$rate, 6)
n_rate <- b_rate %>% filter(bin == 0) %>% drop_na()

s_neg <- n_rate %>% filter(spoiler == 1) %>% drop_na()
n_neg <- n_rate %>% filter(spoiler == 0) %>% drop_na()


res <- testing(n_neg$rate, s_neg$rate,
               'без спойлеров', 'со спойлерами', 
               0.3, plt='hist', bin=6)

res$test
## [1] 0.07312079

p-value = 0.07312079
p-value > 0.05, однако p-value очень мало. Мы все равно будем считать, что мы не можем отвергнуть H0. Зависимость между наличием спойлеров с оценкой фильма ниже 6 нет. Следовательно просто будем говорить, что в отзывах с высокой оцененкой спойлеров меньше.

res$plot +
      ggtitle("Кол-во просмотров фильма для отзывов с оценкой <= 6") +
      xlab("Оценка фильма") + 
      ylab("Кол-во") +
      scale_fill_discrete(name = "Наличие спойлера")

Зависимость спойлера от типа: тв шоу vs фильм

Теперь посмотрим на зависимости написания спойлера от типа произведения (сериал или фильм). Кажется, что под сериалами будет больше спойлеров. Здесь уже будем использовать Хи-квадрат, так как данные качественные номинальные.

Посмотрим как распределены данные по времени

df %>% select(year, type) %>%
        group_by(year, type) %>% 
        count() %>%
        arrange(year)  %>% 
        ggplot() +
        geom_point(aes(x=year, y=n, color=type), alpha=0.9, size=3) + 
        theme_minimal() + 
        scale_x_continuous(breaks = seq(1921, 2019, by = 10)) +
        ggtitle("Количество фильмов и сериалов по годам выхода") +
        xlab("Год") + 
        ylab("Кол-во") +
        scale_fill_discrete(name = "Наличие спойлера")

Анализ

H0 - Зависимость нет
H1 - Зависимость есть

s_type <- df %>% select(spoiler, type) %>% group_by(spoiler, type) %>% table()

s_type
##        type
## spoiler movies   tv
##       0   3842 2894
##       1   1132  514
chisq.test(s_type)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  s_type
## X-squared = 75.026, df = 1, p-value < 2.2e-16

p-value < 2.2e-16
p-value < 0.05
Следовательно мы отвергаем H0. Зависимость между наличием спойлеров и типом произедения есть.

bar_plot(no_spoil$type, spoil$type, 'без спойлеров', "со спойлерами", 0.3) +
      ggtitle("График зависимости кол-ва спойлеров от типа произведения") +
      xlab("Тип произведения") + 
      ylab("Кол-во") +
      scale_fill_discrete(name = "Наличие спойлера")

К фильмам спойлеров пишут больше.

Зависимость спойлера от рейтинга фильма: high vs low

Кажется, что у фильмов с низким рейтингом будет больше спойлеров, потому что такие фильмы люди обычно смотрят ради веселье и особо не переживают из-за выданных сюжетных деталей.

Посмотрим как распределены данные по времени

df %>% select(year, top) %>%
        group_by(year, top) %>% 
        count() %>%
        arrange(year)  %>% 
        ggplot() +
        geom_point(aes(x=year, y=n, color=top), alpha=0.9, size=3) + 
        theme_minimal() + 
        scale_x_continuous(breaks = seq(1921, 2019, by = 10)) +
        ggtitle("Количество low rated и high rated произведений по годам выхода") +
        xlab("Год") + 
        ylab("Кол-во") +
        scale_fill_discrete(name = "Наличие спойлера")

В последнее время стало очень много low rated произведений :))))

Анализ

H0 - Зависимость нет
H1 - Зависимость есть

s_top <- df %>% select(spoiler, top) %>% group_by(spoiler, top) %>% table()

s_top
##        top
## spoiler  low  top
##       0 2851 3885
##       1  670  976
chisq.test(s_top)
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  s_top
## X-squared = 1.3594, df = 1, p-value = 0.2436

p-value = 0.2436
p-value > 0.05
Следовательно мы не можем отвергнуть H0. Зависимости между наличием спойлеров и рейтингом нет

bar_plot(no_spoil$top, spoil$top, 'без спойлеров', "со спойлерами", 0.3) +
      ggtitle("График зависимости кол-ва спойлеров от рейтинга фильма") +
      xlab("Тип рейтинга") + 
      ylab("Кол-во") +
      scale_fill_discrete(name = "Наличие спойлера")

Зависимость спойлера от времени выхода фильма

Кажется, что чем раньше вышел фильм, тем спойлеров к нему должно быть больше, потому что большинство уже должно было посмотреть фильм или знать его сюжет.

H0 - Зависимость нет
H1 - Зависимость есть

Проверим на нормальность

ggqqplot(df$year)

Данные не распределены нормально. Данные количественные. В качестве теста будем использовать Критерий Манна-Уитни.

res <- testing(no_spoil$year, spoil$year,
               'без спойлеров', 'со спойлерами', 
               0.3, plt='dens', ) 

res$test
## [1] 0.4336374

p-value = 0.4336374
p-value > 0.05
Следовательно мы не можем отвергнуть H0. Зависимости между наличием спойлеров и годом выхода фильма нет.

res$plot +
      ggtitle("График плотности даты выхода фильма в зависимости от наличия спойлеров в отзыве") +
      xlab("Год выхода фильма") + 
      ylab("Плотность") +
      scale_fill_discrete(name = "Наличие спойлера")

Частотностные слова в заголовках отзывов

Сравним 4 списка слов: заголовки отзывов с положительной оценкой (> 6), негативной (< 6) и со спойлерами и без. Предварительно лемматизируем и удалим стопслова.

# Функция рисует график самых частотных слов

top_n_words <- function(data, top){
  
  p <- data %>%
  top_n(top) %>%
    mutate(name = fct_reorder(word, n)) %>%
    ggplot(aes(x=name, y=n)) +
    geom_bar(stat="identity", fill="#f68060", alpha=0.6, width=0.4) +
    coord_flip() +
    xlab("") +
    theme_bw()
  return(p)
}

#  Загружаем стопслова

stops <- get_stopwords()
filename <- "data/stops.csv"
my_stops <- read.delim(filename, sep='\t', header = TRUE)
stops <- rbind(stops, my_stops)


b_rate['title'] <- as.character(df$title)
spoil['title'] <- as.character(spoil$title)
no_spoil['title'] <- as.character(no_spoil$title)

bin_words <- b_rate %>% select(bin, title) %>% 
      drop_na() %>%
      unnest_tokens(word, title) %>% 
      mutate(word = lemmatize_words(word)) %>%
      count(bin, word, sort = TRUE) %>% 
      anti_join(stops) 
## Joining, by = "word"
p1 <- bin_words %>% filter(bin == 1) %>%
                    top_n_words(20) +
                    ggtitle("Положительная оценка")
## Selecting by n
p2 <- bin_words %>% filter(bin == 0) %>%
                    top_n_words(20) +
                    ggtitle("Отрицательная оценка")
## Selecting by n
p3 <- spoil %>% select(title) %>% 
      drop_na() %>%
      unnest_tokens(word, title) %>% 
      mutate(word = lemmatize_words(word)) %>%
      count(word, sort = TRUE) %>% 
      anti_join(stops)  %>%
      top_n_words(20) +
      ggtitle("Отзыв со спойлерами")
## Joining, by = "word"Selecting by n
p4 <- no_spoil %>% select(title) %>% 
      drop_na() %>%
      unnest_tokens(word, title) %>% 
      mutate(word = lemmatize_words(word)) %>% 
      count(word, sort = TRUE) %>% 
      anti_join(stops)  %>%
      top_n_words(20) +
      ggtitle("Отзыв без спойлеров")
## Joining, by = "word"Selecting by n
grid.arrange(p1, p2, p3, p4, nrow=2)

Ну, в списках для заголовков отзывов со спойлерами и без разницы особо нет, кроме наличия слова “spoiler”. А вот отзывы с разной оценкой отличаются. В отзывах пользователей, которые оценили фильмы ниже 6 баллов, встречаются такие сильно негативно окрашенные слова, как “bad”, “awful”, “terrible”. В отзывах же с позитивной оценкой встречаются слова “good”, “great”, “masterpiece”, “excellent”, “amaze” (которое скорее всего amaze), что в принципе ожидаемо.

А что будет в нграммах?

Частотностные bigrams в заголовках отзывов

bin_words <- b_rate %>% select(bin, title) %>% 
             drop_na() %>%
             unnest_tokens(word, title, token = "ngrams", n = 2) %>% 
             #separate(word, c("w1", "w2"), " ") %>% 
            # mutate(w1 = lemmatize_words(w1)) %>%
            # mutate(w2 = lemmatize_words(w2)) %>%
            # mutate(word = str_c(w1," ", w2)) %>%
             count(bin, word, sort = TRUE)


# Убираем строчки, содержащие стоп слова
swc <- paste(stops$word, collapse = "|")  
bin_words <- bin_words[str_detect(bin_words$word, swc) == FALSE,] 


p1 <- bin_words %>% filter(bin == 1) %>%
                    top_n_words(20) +
                    ggtitle("Положительная оценка")
## Selecting by n
p2 <- bin_words %>% filter(bin == 0) %>%
                    top_n_words(20) +
                    ggtitle("Отрицательная оценка")
## Selecting by n
grid.arrange(p1, p2, nrow=1)

Интересные результаты. В результаты попали упоминания десятилетий (80’s, 90’s), оценки зрителей (8/10, 0/10) и даже названия фильмов и сериалов (“speed 2” явно от need for speed, а “teen wolf” - название сериала)

Частотностные слова в полных текстах отзывов без лемматизации

b_rate['text'] <- as.character(df$text)
spoil['text'] <- as.character(spoil$text)
no_spoil['text'] <- as.character(no_spoil$text)

bin_words <- b_rate %>% select(bin, text) %>% 
      drop_na() %>%
      unnest_tokens(word, text, token = "ngrams", n = 2) %>% 
      count(bin, word, sort = TRUE) %>% 
      anti_join(stops) 
## Joining, by = "word"
# Убираем строчки, содержащие стоп слова
swc <- paste(stops$word, collapse = "|")  
bin_words <- bin_words[str_detect(bin_words$word, swc) == FALSE,] 


p1 <- bin_words %>% filter(bin == 1) %>%
                    top_n_words(20) +
                    ggtitle("Положительная оценка")
## Selecting by n
p2 <- bin_words %>% filter(bin == 0) %>%
                    top_n_words(20) +
                    ggtitle("Отрицательная оценка")
## Selecting by n
grid.arrange(p1, p2, ncol=2)

Вполне ожидаемые результаты.

В отзывах с положительной оценкой достаточно частотно выражение “red shoes”. Немного старнно. Узнаем что это и откуда.

movies <- df$movie_id[str_detect(df$text, "red shoes") == TRUE]

unique(movies)
## [1] "tt0040725"
length(movies)
## [1] 6

Это словосочетание встречается в 6 отзывах только под одним фильмом под id tt0040725. И это фильм под названием “The Red Shoes” :)

Оценки в текстах отзывов

Списки частотных слов, в которых встретились оценки фильмов, навели меня на мысль, всегда ли оценка у отзыва (та, что отображается у самого комментария со знаком звездочки) совпадает с тем, как люди оценивают фильм в самом текст отзыва, если нет, то что более характерно: увеличение первоначальной оценки или уменьшение. Для того, чтобы проверить эту теорию, найдем все последовательности вида “8/10”, “4/5” и тд. в текстах отзывов и в заголовках и посмотрим на разницу значений.

# Функция достает рейтинги из текстов

find_rate <- function(line, reg){
  a <- str_match(line, "(?:(-?[0-9]+(?:\\.[0-9])?)|([0-9]+)-[0-9]+)/((?:10+|5)(?:\\.0)?)")
  res <-rep(NA, nrow(a))
  res[which(!is.na(a[,2]))] <- as.integer(a[,2][which(!is.na(a[,2]))])
  res[which(!is.na(a[,3]))] <- as.integer(a[,3][which(!is.na(a[,3]))])
  return(list(val=res, out=as.integer(a[,4])))
}

rate_titl <- find_rate(df$title, reg)
rate_text <- find_rate(df$text, reg)

index_titl <- which(!is.na(rate_titl$val))
index_text <- which(!is.na(rate_text$val))

common <- intersect(index_titl, index_text)
index <- index_text[!index_text %in% common]

rate_titl$val[index] <- rate_text$val[index]
rate_titl$out[index] <- rate_text$out[index]
index_titl <- which(!is.na(rate_titl$val))

missmatch <- which(rate_titl$val[index_titl] != df$rate[index_titl])

new_rates <- data.frame(rate=df$rate[index_titl][missmatch],
                text_rate=rate_titl$val[index_titl][missmatch],
                out=rate_titl$out[index_titl][missmatch])

head(new_rates)
##   rate text_rate out
## 1    1         0  10
## 2    1         0  10
## 3    1         0  10
## 4    1         0  10
## 5    1         0  10
## 6    6         1  10

Так как максимальное значение оценки в текстах может отличаться от 10, например, 4/5, посчитаем доли.

new_rates['old'] <- new_rates$rate / 10
new_rates['new'] <- new_rates$text_rate / new_rates$out

summary(new_rates)
##       rate          text_rate             out             old        
##  Min.   : 1.000   Min.   :  -10000   Min.   :  5.0   Min.   :0.1000  
##  1st Qu.: 1.000   1st Qu.:       1   1st Qu.: 10.0   1st Qu.:0.1000  
##  Median : 7.000   Median :       6   Median : 10.0   Median :0.7000  
##  Mean   : 5.966   Mean   :   49665   Mean   : 11.6   Mean   :0.5966  
##  3rd Qu.:10.000   3rd Qu.:       9   3rd Qu.: 10.0   3rd Qu.:1.0000  
##  Max.   :10.000   Max.   :10000000   Max.   :100.0   Max.   :1.0000  
##       new           
##  Min.   :  -1000.0  
##  1st Qu.:      0.1  
##  Median :      0.8  
##  Mean   :   4966.4  
##  3rd Qu.:      1.0  
##  Max.   :1000000.0

Видно, что оценки в текстах (text_rate) могут принимать не только больщие значения (10000000), но и отрицательные, что используется для передачи сильного недовольства или восторга фильма соответственно. Так как подобные значения будет очень сложно визуализировать, прошкалируем их следующим образом: тем оценкам, которые сильно привышают возможный range (1000/10), присвоем значение 11, чтобы отличать их от 10/10. Отрицательным аналогам (-1000/10) присвоем значение -1.

ind <- new_rates$text_rate > 10 & new_rates$text_rate > new_rates$out
new_rates$text_rate[ind] <- 11
new_rates$out[ind] <- 10

ind2 <- new_rates$text_rate < 0 & new_rates$text_rate < new_rates$out
new_rates$text_rate[ind2] <- -1
new_rates$out[ind2] <- 10

new_rates['old'] <- new_rates$rate / 10
new_rates['new'] <- new_rates$text_rate / new_rates$out

new_rates <- new_rates[!(new_rates$old==new_rates$new),]
new_rates["index"] <- 1:nrow(new_rates)

Чтобы понять, какая разница между оценками у отзыва и внутри текста, посчитаем разницу между двумя значениями. Если разница > 0, значит оценка фильма в тексте отзыва ниже, оценки у отзыва. Если разница < 0, оценка в тексте отзыва больше оценки у поста.

new_rates['dist'] <- new_rates$old - new_rates$new

new_rates %>% ggplot(aes(x=index, y=dist)) +
  geom_segment( aes(x=index, xend=index, y=0, yend=dist), color="grey") +
  geom_point(size=0.5, color="orange") +
  theme_light() +
  ggtitle("График разницы между выставленной оценкой и оценкой в тексте отзыва") +
  xlab("Отзыв") + 
  ylab("Разница")

Видно, что отзывов, где оценка в тексте больше оценки у поста, больше.

l1 <- length(new_rates$dist[new_rates$dist > 0]) # 220
l2 <- length(new_rates$dist[new_rates$dist <= 0]) # 162

paste("Разница > 0 =", l1,"; Разница < 0 =",l2)
## [1] "Разница > 0 = 110 ; Разница < 0 = 81"

Из проведенного эксперемента можно сделать вывод, что люди чаше оценивают фильмы выше, чем заданная шкала оценок, чем наоборот.

Длины комментариев

df['text'] <- as.character(df$text)
df_len <- df %>% mutate(len = nchar(text)) %>% select(date, len)
df_len['year'] <- str_extract(df_len$date, '[1-2]\\d{3}')


df_len %>% 
        ggplot(aes(x=year, y=len)) +
        geom_boxplot() +
        theme_minimal()+
        ggtitle("График длин отзывов в каждый год ") +
        xlab("Год") + 
        ylab("Длина")

Активность пользователей

А теперь сделаем красивый график с пользователи, которые оставляли отзывы.

users <- df %>% select(user) %>% table() 
users <- data.frame(users)
colnames(users) <- c("user", "n")

packing <- circleProgressiveLayout(users$n, sizetype='area')
users <- cbind(users, packing)
dat.gg <- circleLayoutVertices(packing, npoints=50)

users$user[users$n < 8] <- ""

ggplot() + 

  geom_polygon(data = dat.gg, aes(x, y, group = id, fill=as.factor(id)), 
               colour = "black", alpha = 0.6) +

  geom_text(data = users, aes(x, y, size=n/2, label = user)) +
  scale_size_continuous(range = c(1,4)) +

  theme_void() + 
  theme(legend.position="none") +
  coord_equal()

На графике за размер кружков отвечает кол-во отзывов, которое оставил пользователь. Видно, что есть люди, которые часто пишут отзывы.

Заядлые спойлерщики

act_us <- users %>% filter(n > 10) 
act_us["user"] <- as.character(act_us$user)
df["user"] <- as.character(df$user)


df %>% filter(user %in% act_us$user) %>% 
       group_by(user, spoiler) %>% count()  %>%
       ggplot(aes(x=user, y=n, fill=as.character(spoiler))) + 
       geom_bar(position="stack", stat="identity")+ 
      scale_fill_manual("Отзыв", values=c("gray83", "skyblue2"),
                        labels = c("Без спойлеров", "Со спойлерами")) +
      geom_text(aes(label=n), vjust=0, color="black", size=2, position=position_stack(0.5)) + 
      theme_minimal() + 
      ggtitle("Кол-во отзывов пользователей в зависимости от наличия в нем спойлеров") +
      xlab("Пользователь") + 
      ylab("Кол-во")+ theme(axis.text.x = element_text(angle = 90, hjust = 1))

Есть пользователи, которые больше спойлерят, чем нет.

Итог

Из 6 гипотез подтвердились 3, и 3 гипотезы опроверглись.

+

-